home *** CD-ROM | disk | FTP | other *** search
- unit GifEdit;
-
- interface
-
- uses WinTypes, WinProcs, Classes, Graphics, Forms, Controls, Buttons,
- StdCtrls, ExtCtrls, RzPrgres, GifImg, FileCtrl, DsgnIntf, SysUtils;
-
- type
- TGifProperty = class(TClassProperty)
- public
- function GetAttributes: TPropertyAttributes; override;
- procedure Edit; override;
- procedure SetValue(const Value: String);
- function GetValue: String;
- end;
-
- TGifPropertyClass = class of TGifProperty;
-
- TGifForm = class(TForm)
- OKBtn: TBitBtn;
- CancelBtn: TBitBtn;
- FileBevel: TBevel;
- DriveList: TDriveComboBox;
- DirectoryList: TDirectoryListBox;
- FileList: TFileListBox;
- FilePanel: TPanel;
- LoadProgress: TRzProgressBar;
- GifImageCtl: TGifImage;
- procedure FileListChange(Sender: TObject);
- procedure BtnClick(Sender: TObject);
- procedure GifImageCtlStatusChange(Sender: TObject; Status: TGifStatus);
- private
- { Private declarations }
- function Execute(CurrentFile: TFileName): TModalResult;
- public
- { Public declarations }
- end;
-
- TValidDrives = set of Char;
-
- var
- GifForm: TGifForm;
- GifImageCtl: TGifImage;
- GifFileName: String;
- GifResult: TModalResult;
-
- const
- GifRect: TRect = (Left: 190; Top: 35; Right: 341 + 190; Bottom: 271 + 35);
- ValidDrives: TValidDrives = ['A','B','C','D','E','F','G','H','I','J','K','L','M',
- 'N','O','P','Q','R','S','T','U','V','W','X','Y','Z'];
- implementation
-
- {$R *.DFM}
-
- function TGifProperty.GetAttributes: TPropertyAttributes;
- begin
- Result := [paDialog];
- end;
-
- procedure TGifProperty.Edit;
- begin
- GifForm := TGifForm.Create(Application);
- with GifForm do
- try
- GifFileName := GetValue;
- if Execute(GifFileName) = mrOK then
- SetValue(GifFileName);
- finally
- Free;
- end;
- end;
-
- procedure TGifProperty.SetValue(const Value: String);
- begin
- TGif(GetOrdValue).LoadFromFile(Value);
- end;
-
- function TGifProperty.GetValue: String;
- begin
- Result := TGif(GetOrdValue).FileName;
- end;
-
- procedure TGifForm.FileListChange(Sender: TObject);
- begin
- FilePanel.Caption := FileList.FileName;
- if FileExists(FileList.FileName) then
- GifImageCtl.Gif.LoadFromFile(FileList.FileName);
- end;
-
- function TGifForm.Execute(CurrentFile: TFileName): TModalResult;
- var
- Drv: Char;
- begin
- Drv := UpperCase(CurrentFile)[1];
- if FileExists(CurrentFile) then
- begin
- if Drv in ValidDrives then
- DriveList.Drive := CurrentFile[1];
- DirectoryList.Directory := ExtractFilePath(CurrentFile);
- if FileList.Items.IndexOf(ExtractFileName(CurrentFile)) >= 0 then
- FileList.FileName := ExtractFileName(CurrentFile);
- end;
- ShowModal;
- Result := GifResult;
- end;
-
- procedure TGifForm.BtnClick(Sender: TObject);
- begin
- GifResult := TBitBtn(Sender).ModalResult;
- GifFileName := FileList.FileName;
- Close;
- end;
-
- procedure TGifForm.GifImageCtlStatusChange(Sender: TObject;
- Status: TGifStatus);
- begin
- LoadProgress.PartsComplete := Status;
- end;
-
- end.
-